home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / HardwareProjects / VideoText.lha / VideoText4.2 / source / i2c_serial.p < prev    next >
Encoding:
Text File  |  1995-05-25  |  9.8 KB  |  274 lines
  1. UNIT i2c_serial; {$project vt}
  2. { Steuert I²C-Bus Interface am seriellen Port des Amiga }
  3.  
  4. INTERFACE;
  5.  
  6. CONST maxerror=5;
  7.  
  8. VAR i2c_error: ARRAY[0..maxerror] OF Str;
  9. VAR i2c_status, busdelay: Integer;
  10.  
  11. PROCEDURE i2cbusIO(busaddr: byte; buffer: Ptr; data: Integer);
  12. PROCEDURE setregister(addr,reg,value: Byte);
  13. FUNCTION getregister(addr,reg: Byte): Byte;
  14. {$ulink "vt/s_i2cbusIO.o" }
  15.  
  16. { ---------------------------------------------------------------------- }
  17.  
  18. IMPLEMENTATION;
  19.  
  20. {$opt q,s+,i+ } { keine Laufzeitprüfungen außer Stack und Feldindizes }
  21. {$incl "exec.lib", "intuition.lib", "hardware/cia.h" }
  22. {$incl "exec/semaphores.h", "resources/misc.h", "misc.lib" }
  23.  
  24. CONST CLKHI =  CIAF_COMRTS; CLKLO =  NOT CLKHI;  CLKIN =  CIAF_COMCTS;
  25.       DATAHI = CIAF_COMDTR; DATALO = NOT DATAHI; DATAIN = CIAF_COMCD;
  26.       myname = 'I²C-bus';
  27.       semname = 'i2c-serial';
  28.       dummyname = 'i2c-sdummy';
  29.  
  30. TYPE sem_mem = RECORD
  31.        size: Word;
  32.        sem: SignalSemaphore;
  33.        name: String[15];
  34.      END;
  35.  
  36. VAR owner1,owner2: Ptr;
  37.     ciab: ^CIA;
  38.     mysem,dummysem: p_SignalSemaphore;
  39.     mymem: ^sem_mem;
  40.  
  41. PROCEDURE retreat;
  42. { Semaphore abbauen, ggf. Resourcen freigeben }
  43. BEGIN
  44.   dummysem := FindSemaphore(dummyname);
  45.   IF dummysem<>Nil THEN BEGIN  { ich bin nicht allein }
  46.     RemSemaphore(dummysem);  { Dummy aus der Liste streichen }
  47.     mymem := Ptr(Long(dummysem)-2);
  48.     FreeMem(mymem,mymem^.size); { und Speicher freigeben }
  49.     { Ich brauche keine Resources freizugeben! }
  50.   END ELSE BEGIN  { es läuft KEIN Partnerprogramm }
  51.     mysem := FindSemaphore(semname);
  52.     IF mysem<>Nil THEN BEGIN
  53.       RemSemaphore(mysem);
  54.       mymem := Ptr(Long(mysem)-2);
  55.       FreeMem(mymem,mymem^.size);
  56.     END;
  57.     IF owner1 = Nil THEN FreeMiscResource(MR_SERIALBITS);
  58.     IF owner2 = Nil THEN FreeMiscResource(MR_SERIALPORT);
  59.   END;
  60. END;
  61.  
  62. PROCEDURE user_meinung;
  63. { mit Alert nachfragen, ob ein fremder Ressourceninhaber ignoriert werden soll }
  64. VAR rache: Boolean;
  65.     zeile1,zeile2: String[80];
  66.     buf: String[200];
  67.     xpos, l1, l2: Integer;
  68. BEGIN
  69.   zeile1 := 'Serial ressources are owned by "';
  70.   IF owner1<>Nil THEN zeile1 := zeile1 + copy(str(owner1),1,16);
  71.   zeile1 := zeile1 + '"/"';
  72.   IF owner2<>Nil THEN zeile1 := zeile1 + copy(str(owner2),1,16);
  73.   zeile1 := zeile1 + '"!';
  74.   l1 := length(zeile1);
  75.   zeile2 := 'LEFT BUTTON = IGNORE                 '
  76.            +'              RIGHT BUTTON = OOPS ...';
  77.   l2 := length(zeile2);
  78.   buf := '   '+zeile1+'     '+zeile2;
  79.   xpos := 320 - 4*l1;
  80.   buf[1] := chr(Hi(xpos)); buf[2] := chr(Lo(xpos));
  81.   buf[3] := chr(16);
  82.   buf[l1+4] := chr(0); buf [l1+5] := chr(1); { Fortsetzungsbyte }
  83.   xpos := 320 - 4*l2;
  84.   buf[l1+6] := chr(Hi(xpos)); buf[l1+7] := chr(Lo(xpos));
  85.   buf[l1+8] := chr(32);
  86.   buf [l1+l2+10] := chr(0); { Ende }
  87.   OpenLib(IntuitionBase,'intuition.library',0);
  88.   rache := DisplayAlert(RECOVERY_ALERT,buf,44);
  89.   CloseLib(IntuitionBase);
  90.   IF rache THEN BEGIN
  91.     owner1 := Nil; owner2 := Nil;
  92.   END ELSE
  93.     Error('cannot allocate serial port!');
  94. END;
  95.  
  96. PROCEDURE setup;
  97. { Semaphor einrichten, CIA-Register initialisieren, ggf. Ressourcen anfordern }
  98. BEGIN
  99.   owner1 := Ptr(4); owner2 := Ptr(4); { Hauptsache <>Nil !!! }
  100.   mymem := AllocMem(SizeOf(sem_mem),MEMF_PUBLIC);
  101.   IF mymem=Nil THEN Error('no memory for semaphore');
  102.   mymem^.size := SizeOf(sem_mem);
  103.   dummysem := ^mymem^.sem;
  104.   dummysem^.ss_Link.ln_Name := ^mymem^.name;
  105.   dummysem^.ss_Link.ln_Type := NT_SEMAPHORE;
  106.   mysem := FindSemaphore(semname);  { bereits ein Semaphor installiert? }
  107.   IF mysem=Nil THEN BEGIN   { nein, ich bin allein }
  108.     mymem^.name := semname;
  109.     mysem := dummysem;
  110.     AddSemaphore(mysem);
  111.     { darum muß ich mich auch um die Resources kümmern }
  112.     owner1 := ptr(AllocMiscResource(MR_SERIALBITS, myname));
  113.     owner2 := ptr(AllocMiscResource(MR_SERIALPORT, myname));
  114.     IF (owner1<>Nil) OR (owner2<>Nil) THEN
  115.       user_meinung;
  116.   END ELSE BEGIN  { Partnerprogramm hat Semaphor schon installiert, }
  117.     { ich muß aber noch einen Dummy-Semaphor aufstellen. }
  118.     mymem^.name := dummyname;
  119.     AddSemaphore(dummysem);
  120.     owner1 := Nil; owner2 := Nil;
  121.   END;
  122.   ciab := ptr(Adr_ciab);
  123.   { CTS- und DCD-Bit auf Eingang, RTS und DTR auf Ausgang }
  124.   ciab^.ciaddra := (ciab^.ciaddra AND NOT (CIAF_COMCD OR CIAF_COMCTS))
  125.     OR CIAF_COMRTS OR CIAF_COMDTR;
  126. END;
  127.  
  128.  
  129. { *** Ende der Init-/Cleanup-Routinen. Es folgen die Anwenderroutinen. }
  130.  
  131.  
  132. FUNCTION s_i2cbusIO(busaddr: byte; buffer: Ptr; data: Integer;
  133.                     busdelay: Integer): Integer; IMPORT;
  134.  
  135. { Ich kann leider nicht direkt eine Assembler-Routine namens "i2cbusIO" }
  136. { importieren, da dann das Unit diesen Bezeichner sowohl importieren als }
  137. { auch exportieren müßte, hähä. }
  138.  
  139. {$opt q,s+}
  140. PROCEDURE i2cbusIO{(busaddr: byte; buffer: Ptr; data: Integer)};
  141. { Startet den I²C-Bus und spricht den Chip mit Nr. <busaddr> an. Ist <data> }
  142. { positiv, werden <data> Bytes ab Adresse <buffer> über den Bus abgeschickt, }
  143. { sonst werden <-data> Bytes vom Bus geholt und ab Adresse <buffer> im }
  144. { Speicher abgelegt. Anschließend wird der I²C-Bus wieder gestoppt. }
  145. { Setzt als zusätzliche Rückmeldung die globale Variable "i2c_status": }
  146. {   0 = fehlerfreie Übertragung }
  147. {   1 = unquittierte Daten }
  148. {   2 = angesprochener Chip antwortet nicht }
  149. {   3 = gesendete Daten wurden zerstört }
  150. {   4 = gesendete Daten zu Null verfälscht }
  151. {   5 = gesendete Daten zu Einsen verfälscht }
  152. { Anmerkungen: }
  153. { 1. Das unterste Bit in <busaddr> wird ignoriert und entsprechend der }
  154. {   I²C-Bus-Konvention auf 0 für Schreiben bzw. 1 für Lesen gesetzt. }
  155. { 2. Mehr Bytes zum Lesen anzufordern, als der bereitgestellte Puffer fassen }
  156. {   kann, ist ein Fehler, der nicht erkannt wird und wahrscheinlich mit einem }
  157. {   GURU endet. }
  158. { Die Variable <busdelay> steuert eine Zählschleife (sic!) und sollte auf }
  159. { normalen Amigas 0 sein. Für beschleunigte Amigas sollte hier ein geeigneter }
  160. { Wert den Bus auf die erlaubten 100 kHz bremsen können. }
  161. BEGIN
  162.   ObtainSemaphore(mysem);
  163.   i2c_status := s_i2cbusIO(busaddr,buffer,data,busdelay);
  164.   ReleaseSemaphore(mysem);
  165. END;
  166. {VAR buf: ^Array[1..MAXINT] of byte;
  167.     i,bit,send,recv,l: integer;
  168.     x,y: byte;
  169.     myCIAport: Byte ABSOLUTE $BFD000;
  170. LABEL panic;
  171. BEGIN
  172.   ObtainSemaphore(mysem);
  173.   i2c_status := 0
  174.   buf := buffer;
  175.   send := 0; recv := 0;
  176.   IF data>0 THEN  send := data  else  recv := -data;
  177.   busaddr := busaddr AND $FE;  IF recv>0 THEN busaddr := busaddr OR 1;
  178.   { Bus starten: Protokollverletzung mit H->L }
  179.   myCIAport := myCIAport OR CLKHI OR DATAHI; for l := 1 to busdelay DO;
  180.   myCIAport := myCIAport AND DATALO;  for l := 1 to busdelay DO;
  181.   myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  182.   { Daten senden, mindestens ein Byte für die Adressierung: }
  183.   for i := 0 to send DO BEGIN
  184.     IF i=0 THEN  x := busaddr  else  x := buf^[i];
  185.     y := 0; { sollte bei korrekter und ungestörter Hardware am Ende =x sein }
  186.     for bit := 7 downto 0 DO BEGIN
  187.       y := y SHL 1;
  188.       IF ((x shr bit) AND $01) = 0 THEN
  189.         myCIAport := myCIAport AND DATALO
  190.       else
  191.         myCIAport := myCIAport OR DATAHI;
  192.       myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  193.       IF (myCIAport AND DATAIN)<>0 THEN Inc(y);
  194.       myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  195.     END;
  196.     IF y<>x THEN BEGIN
  197.       IF y=$FF THEN i2c_status := 5
  198.       ELSE IF y=0 THEN i2c_status := 4
  199.       ELSE i2c_status := 3;
  200.       GOTO panic;
  201.     END;
  202.     { Quittierungsbit lesen }
  203.     myCIAport := myCIAport OR DATAHI;
  204.     myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  205.     IF (myCIAport AND DATAIN)<>0 THEN BEGIN
  206.       { Quittierungsbit = H: bitte keine weiteren Daten, Abbruch. }
  207.       { Falls das schon beim Senden der Adresse auftritt (i=0), hat überhaupt }
  208.       { kein Busteilnehmer zugehört: falsche Adresse oder Hardwareproblem. }
  209.       IF i=0 THEN  i2c_status := 2  else  i2c_status := 1;
  210.       GOTO panic;
  211.     END;
  212.     myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  213.   END;
  214.   { Daten empfangen, sofern verlangt: }
  215.   for i := 1 to recv DO BEGIN
  216.     myCIAport := myCIAport OR DATAHI; { sonst liest man nur das eigene LO! }
  217.     x := 0;
  218.     for bit := 7 downto 0 DO BEGIN
  219.       x := x shl 1;
  220.       myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  221.       IF (myCIAport AND DATAIN)<>0 THEN Inc(x);
  222.       myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  223.     END;
  224.     { Quittierungsbit senden }
  225.     IF i=recv THEN    { letztes Byte mit HI quittieren, sonst LO }
  226.       myCIAport := myCIAport OR DATAHI
  227.     else
  228.       myCIAport := myCIAport AND DATALO;
  229.     myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  230.     myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  231.     buf^[i] := x;
  232.   END;
  233. panic:
  234.   { Bus stoppen: Protokollverletzung mit L->H }
  235.   myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  236.   myCIAport := myCIAport AND DATALO;  for l := 1 to busdelay DO;
  237.   myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  238.   myCIAport := myCIAport OR DATAHI;
  239.   ReleaseSemaphore(mysem);
  240. END;}
  241. {$opt i+}
  242.  
  243. PROCEDURE setregister{(addr,reg,value: Byte)};
  244. { Häufig benötigter Vorgang: ein einzelnes Register am I²C-Bus beschreiben. }
  245. VAR bytes: array[1..2] of Byte;
  246. BEGIN
  247.   bytes[1] := reg; bytes[2] := value;
  248.   i2cbusIO(addr,^bytes,2);
  249. END;
  250.  
  251. FUNCTION getregister{(addr,reg: byte): Byte};
  252. { Etwas umständlicher, wird dafür auch seltener benötigt: ein einzelnes }
  253. { Register auslesen. NICHT schleifenweise aufrufen, um mehrere Bytes zu }
  254. { lesen! Das läßt sich direkt über i2cbusIO() eleganter regeln! }
  255. VAR result: Byte;
  256. BEGIN
  257.   i2cbusIO(addr,^reg,1);
  258.   i2cbusIO(addr,^result,-1);
  259.   getregister := result;
  260. END;
  261.  
  262. BEGIN  { Initialisierungsteil }
  263.   busdelay := 0;
  264.   i2c_error[0] := 'OK';
  265.   i2c_error[1] := 'unquittierte Daten';
  266.   i2c_error[2] := 'Chip antwortet nicht';
  267.   i2c_error[3] := 'gesendete Daten zerstört';
  268.   i2c_error[4] := 'SDA auf LO festgehalten';
  269.   i2c_error[5] := 'SDA immer HI';
  270.   MiscBase := OpenResource(MISCNAME);
  271.   { Resource braucht *nicht* wieder geschlossen zu werden! }
  272.   AddExitServer(retreat); setup;
  273. END.
  274.